home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Games of Daze
/
Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso
/
x2ftp
/
msdos
/
libs
/
xv_pc17
/
rotor.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1994-04-20
|
6KB
|
227 lines
PROGRAM Rotor;
{
This program demonstrates how to define a new object in the XView-PC
interface unsing the "callbacks" of a "canvas".
Demonstrated is also how to use several "canvas" objects in the same window,
the use of "accelerator keys", and a "trick" to drive an object simulating
events.
By Antonio Carlos Moreirao de Queiroz - acmq@coe.ufrj.br
Version 1.0 - 17/04/94
A rotary button object is created using the "callbacks" of a "canvas".
The angle is kept in "client_data", by a type cast.
Does not work in black and white modes.
}
USES Mickey,XView,Graph;
{The "interposer" for "accelerator keys"}
{$I hotkeys.inc}
{Rotor parameters}
CONST
rmajor=35;
rminor=rmajor div 2;
centerx=rmajor;
centery=rmajor+9;
rbase=rminor+3;
rpoint=rmajor-3;
ht=rpoint-rbase;
ht2=ht div 2;
range=180;
{Graphics board and mode}
board=0;
mode=0;
VAR
frame1,canvas1,canvas2,canvas3,canvas4,tty1:Xv_opaque;
{Auxiliary functions}
FUNCTION Si(x:INTEGER):STRING; {Integer to string converter}
VAR
t:STRING;
BEGIN
Str(x,t);
Si:=t
END;
FUNCTION Angle(x,y:INTEGER):INTEGER; {Full circle ArcTan function}
VAR
t:REAL;
BEGIN
IF x=0 THEN BEGIN
IF y>0 THEN Angle:=range div 2 ELSE Angle:=-range div 2
END
ELSE BEGIN
t:=ArcTan(y/x);
IF x<0 THEN IF y>0 THEN t:=t+Pi ELSE t:=t-Pi;
Angle:=Round(range/Pi*t)
END
END;
PROCEDURE Triangle(angle:INTEGER); {Draws the rotor arrow}
VAR
t:ARRAY[1..3] of RECORD x,y:INTEGER END;
alpha,gamma,asp:REAL;
xasp,yasp:WORD;
BEGIN
GetAspectRatio(xasp,yasp);
asp:=xasp/yasp;
alpha:=angle*Pi/range;
gamma:=Pi/2-alpha;
SetFillStyle(SolidFill,GetColor);
t[1].x:=centerx+Round(rbase*cos(alpha)+ht2*cos(gamma));
t[1].y:=centery-Round(asp*(rbase*sin(alpha)-ht2*sin(gamma)));
t[2].x:=centerx+Round(rbase*cos(alpha)-ht2*cos(gamma));
t[2].y:=centery-Round(asp*(rbase*sin(alpha)+ht2*sin(gamma)));
t[3].x:=centerx+Round((rbase+ht)*cos(alpha));
t[3].y:=centery-Round(asp*((rbase+ht)*sin(alpha)));
FillPoly(3,t);
END;
{$F+}
{Callback procedures}
PROCEDURE DrawRotor(obj:Xv_opaque); {Notify handler for rotors}
BEGIN
SetColor(c_shadow);
Circle(centerx,centery,rmajor);
Circle(centerx,centery,rminor);
SetFillStyle(SolidFill,c_active);
FloodFill(centerx+rmajor-1,centery,c_shadow);
SetColor(c_light);
Arc(centerx,centery,45,225,rminor);
Arc(centerx,centery,225,45,rmajor);
SetColor(c_white);
Triangle(INTEGER(obj^.client_data));
SetColor(c_black);
OutTextXY(0,0,Si(INTEGER(obj^.client_data)));
SetTextJustify(CenterText,BottomText);
OutTextXY(centerx,obj^.dy-1,obj^.xv_label);
END;
PROCEDURE EventsRotor(obj:Xv_opaque); {Event handler for rotors}
VAR
x1,y1:INTEGER;
BEGIN
IF (ie_code=MS_LEFT) or (ie_code=LOC_DRAG) THEN BEGIN
{Sets the viewport, since there is more than one canvas in the window}
x1:=active_w^.x+obj^.x+mrgx+1;
y1:=active_w^.y+obj^.y+mrgy+1;
SetViewPort(x1,y1,x1+obj^.dx-2,y1+obj^.dy-2,ClipOn);
SetColor(c_active);
Triangle(INTEGER(obj^.client_data));
INTEGER(obj^.client_data):=Angle(ie_locx-centerx,centery-ie_locy);
SetColor(c_white);
Triangle(INTEGER(obj^.client_data));
SetFillStyle(SolidFill,c_normal);
Bar(0,0,38,6);
SetColor(c_black);
OutTextXY(0,0,Si(INTEGER(obj^.client_data)));
END
END;
PROCEDURE State(obj:Xv_opaque); {Reads the rotors}
BEGIN
ttysw_output(tty1,'Status:'^M^J);
ttysw_output(tty1,canvas1^.xv_label+': '+Si(INTEGER(canvas1^.client_data))+^M^J);
ttysw_output(tty1,canvas2^.xv_label+': '+Si(INTEGER(canvas2^.client_data))+^M^J);
ttysw_output(tty1,canvas3^.xv_label+': '+Si(INTEGER(canvas3^.client_data))+^M^J);
ttysw_output(tty1,canvas4^.xv_label+': '+Si(INTEGER(canvas4^.client_data))+^M^J);
END;
PROCEDURE Rotate(obj:Xv_opaque); {Moves the rotors simulating events}
VAR
angle:INTEGER;
t:REAL;
BEGIN
angle:=0;
ttysw_output(tty1,'Rotating...(touch a key to stop)'^M^J);
REPEAT
t:=Pi/range*angle;
{ie_code is already MS_LEFT}
ie_locx:=Round(centerx+rmajor*Cos(t));
ie_locy:=Round(centery+rmajor*Sin(t));
EventsRotor(canvas1);
EventsRotor(canvas2);
EventsRotor(canvas3);
EventsRotor(canvas4);
Inc(angle,10);
IF angle>range THEN angle:=10-range
UNTIL mkbhit
END;
PROCEDURE Quit(obj:Xv_opaque);
BEGIN
xv_end:=TRUE
END;
{$F-}
{Creation routine for the rotor}
FUNCTION xv_create_rotor(name:xv_label_type; xx,yy,angle:INTEGER):Xv_opaque;
VAR
rotor:Xv_opaque;
BEGIN
rotor:=xv_create(canvas);
WITH rotor^ DO BEGIN
xv_label:=name;
back_color:=c_normal; fore_color:=c_normal;
x:=xx; y:=yy;
can_xext:=FALSE; dx:=2*centerx+2;
can_yext:=FALSE; dy:=2*centery+2;
notify_handler:=DrawRotor;
event_handler:=EventsRotor;
INTEGER(client_data):=angle;
END;
xv_create_rotor:=rotor
END;
BEGIN
xv_init(board,mode);
{The objects are adjusted to the size of the rotors}
frame1:=xv_create(frame);
WITH frame1^ DO BEGIN
xv_label:='Rotor';
dy:=319;
dymin:=319;
END;
canvas1:=xv_create_rotor('Rotor 1',0,0,45);
canvas2:=xv_create_rotor('Rotor 2',canvas1^.x+canvas1^.dx+5,0,-45);
canvas3:=xv_create_rotor('Rotor 3',canvas2^.x+canvas1^.dx+5,0,-180);
canvas4:=xv_create_rotor('Rotor 4',canvas3^.x+canvas1^.dx+5,0,-180);
{Never referenced buttons can be created without declaration}
WITH xv_create(button)^ DO BEGIN
xv_label:='State';
y:=canvas1^.dy+3;
notify_handler:=State;
END;
WITH xv_create(button)^ DO BEGIN
xv_label:='rOtate';
y:=canvas1^.dy+3; x:=50;
notify_handler:=Rotate;
END;
WITH xv_create(button)^ DO BEGIN
xv_label:='Quit';
y:=canvas1^.dy+3; x:=109;
notify_handler:=Quit;
END;
frame1^.dx:=canvas4^.x+canvas4^.dx+2*mrgx;
frame1^.x:=(GetMaxX-frame1^.dx) div 2;
frame1^.y:=(GetMaxY-frame1^.dy) div 2;
tty1:=xv_create(tty);
tty1^.y:=canvas1^.dy+18;
ttysw_output(tty1,'Demonstration of the rotor object'^M^J);
{"Interposer" installation}
interposer:=HotKeys;
xv_main_loop(frame1);
RestoreCrtMode;
END.